home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln0586.arc / FILLING2.LTG < prev    next >
Text File  |  1986-04-06  |  896b  |  34 lines
  1.  
  2.  
  3.                             Listing 2
  4.               The simplest seed filling algorithm.
  5.  
  6.  
  7. procedure Fill(x,y,NewColor: Integer);
  8.  
  9. var
  10.   EraseColor: Integer;
  11.  
  12.   procedure RecursiveFill(x,y: Integer);
  13.   begin {of procedure RecursiveFill}
  14.   if PD(x,y) = EraseColor      {if point needs filling...}
  15.   then
  16.     begin
  17.     DP(x,y,NewColor);          {fill it}
  18.     RecursiveFill(x-1,y);      {call fill algorithm with neighbors}
  19.     RecursiveFill(x+1,y);
  20.     RecursiveFill(x,y-1);
  21.     RecursiveFill(x,y+1);
  22.     end;
  23.   end; {of procedure RecursiveFill}
  24.  
  25. begin {of procedure Fill}
  26. EraseColor := PD(x,y);                 {record color of seed point}
  27. if EraseColor = NewColor then exit;    {already done}
  28. if EraseColor = -1 then exit;          {seed point is off screen}
  29. RecursiveFill(x,y);
  30. end; {of procedure Fill}
  31.  
  32.  
  33.  
  34.